{
Traviesadora beta 0.2.0.13.33 (30.11.2008)
LastMod: 05.02.2009 by Prof1983

Copyright 2008, travieorama@googlemail.com

This file is part of the taviesadora project

taviesadora is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

taviesadora is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
}
unit ChooseWin;

interface

uses
  Classes, Controls, Dialogs, ExtCtrls, Graphics, Forms, ImgList, Messages, StdCtrls, SysUtils, Variants, Windows,
  PrefController, Unicode;

type
  TChooseProc = procedure(Value: Integer) of object;

type
  TChooseForm = class(TForm)
    lbProfiles: TListBox;
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDeactivate(Sender: TObject);
    procedure lbProfilesClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure lbProfilesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure lbProfilesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  private
    Imglist: TImageList;
    FOnChoose: TChooseProc;
  public
    procedure Init(Pref: TWideStringList; X, Y: Integer; ImageList: TImageList; DefItem: string);
    property OnChoose: TChooseProc read FOnChoose write FOnChoose;
  end;

//var
//  ChooseForm: TChooseForm;

implementation

{uses
  ConnectWin, fMain, TraviesadoraCore;}

{$R *.dfm}

{ TfrmChooseProfile }

procedure TChooseForm.Init(Pref: TWideStringList; X, Y: Integer; ImageList: TImageList; DefItem: string);
var
  i: Integer;
  id: Integer;
  MousePos: Windows.TPoint;
begin
  id := -1;
  DefItem := LowerCase(DefItem);
  for i := 0 to Pref.Count - 1 do
  begin
    lbProfiles.Items.Add(Pref[i]);
    if Pos(DefItem, LowerCase(Pref[i])) = pos(';', LowerCase(Pref[i]))+1 then
    begin
      id := i;
    end;
  end;
  if (X = 0) and (Y = 0) then
  begin
    Win32Check(Windows.GetCursorPos(MousePos));
    Self.Left := MousePos.X;
    Self.Top := MousePos.Y;
  end
  else
  begin
    Self.Left := X;
    Self.Top := Y;
  end;
  imgList := ImageList;
  lbProfiles.ItemHeight := 20;
  lbProfiles.ItemIndex := id;
end;

procedure TChooseForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TChooseForm.FormDeactivate(Sender: TObject);
begin
  Close;
end;

procedure TChooseForm.lbProfilesClick(Sender: TObject);
begin
  if Assigned(FOnChoose) then
    FOnChoose(lbProfiles.ItemIndex);
  Close;
end;

procedure TChooseForm.Timer1Timer(Sender: TObject);
begin
  AlphaBlendValue := AlphaBlendValue +10;
  if (AlphaBlendValue >= 100) then
  begin
    AlphaBlend := False;
    timer1.Enabled := False;
  end;
end;

procedure TChooseForm.lbProfilesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if (lbProfiles.ItemHeight * lbProfiles.Items.Count < Height + 1) then
    lbProfiles.ItemIndex := Round((y-10)/(lbProfiles.ItemHeight));
end;

procedure TChooseForm.lbProfilesDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  s: string;
  i: Integer;
begin
  with lbProfiles.Canvas do
  begin
    pen.Style := psclear;
    brush.Style := bssolid;
    if (state = [odSelected]) or (state = [odFocused]) or (state = [odFocused,odSelected]) then
    begin
      brush.Color := $00CECEF4
    end
    else
    begin
      brush.Color := lbProfiles.Color;
    end;
    Rectangle(rect.Left-1,Rect.top,Rect.Right+1,Rect.Bottom+1);
    font.Color := clblack;
    s := lbProfiles.Items[index];
    delete(s,1,pos(';',s));
    textout(Rect.Left+18,Rect.top+4,s);
    s := lbProfiles.Items[index];
    if Assigned(ImgList) then
    begin
      if (Pos(';',s) > 0) then
      begin
        delete(s,pos(';',s),Length(s));
        i := StrToIntDef(s,0);
        ImgList.ImageType := itImage;
        ImgList.BkColor := clnone;
        ImgList.DrawingStyle := dsTransparent	;
        ImgList.Draw(lbProfiles.Canvas, Rect.Left+2, Rect.Top+2, i, True);
      end;
    end;
  end;
end;

end.
